#lang racket

(require "primitives.rkt")
(require "tunn_common.rkt")

(require openssl)

(ssl-load-verify-root-certificates!	(ssl-make-client-context 'tls)
                                    "./certificate.pem")

;Constructs an SSL tunnel.
(define (make-ssl-tunnel
         lport
         rhost
         rport
         (type 'tls))
  (define listener (tcp-listen lport 16 #t "127.0.0.1"))
  ;Pass pointer to this value around
  (define accbytes (box 0))
  
  ;Outermost thread: the listen-forward loop
  (thread
   (λ()
     (let loop ()
       (define client (tcp-accept-client listener))
       ;Forkout thread: begin forwarding
       (thread
        (λ()
          ;Connect with remote server
          (define remote (ssl-connect-client rhost rport type))
          ;Upstream forks away
          (thread 
           (λ()
             (my-copy-port (tcpclient-input client)
                           (tcpclient-output remote) (λ(c) 
                                                       (set-box! accbytes (+ c (unbox accbytes)))))
             (close-output-port (tcpclient-output remote))
             (close-input-port (tcpclient-input client))
             ))
          ;Downstream stays in same thread
          (my-copy-port (tcpclient-input remote)
                        (tcpclient-output client) (λ(c) 
                                                    (set-box! accbytes (+ c (unbox accbytes)))))
          (close-input-port (tcpclient-input remote))
          (close-output-port (tcpclient-output client))))
       (loop))
     ))
  
  (tunnel
   'ssl
   lport
   rhost
   rport
   listener
   accbytes
   (box 0)
   (box (current-inexact-milliseconds))
   (λ() (tcp-close listener))))

(provide (all-defined-out))